home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol402 / statcorr.arc / CANOR.FOR next >
Encoding:
Text File  |  1985-11-29  |  6.0 KB  |  213 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE CANOR
  5. C
  6. C        PURPOSE
  7. C           COMPUTE THE CANONICAL CORRELATIONS BETWEEN TWO SETS OF
  8. C           VARIABLES.  CANOR IS NORMALLY PRECEDED BY A CALL TO SUBROU-
  9. C           TINE CORRE.
  10. C
  11. C        USAGE
  12. C           CALL CANOR (N,MP,MQ,RR,ROOTS,WLAM,CANR,CHISQ,NDF,COEFR,
  13. C                       COEFL,R)
  14. C
  15. C        DESCRIPTION OF PARAMETERS
  16. C           N     - NUMBER OF OBSERVATIONS
  17. C           MP    - NUMBER OF LEFT HAND VARIABLES
  18. C           MQ    - NUMBER OF RIGHT HAND VARIABLES
  19. C           RR    - INPUT MATRIX (ONLY UPPER TRIANGULAR PORTION OF THE
  20. C                   SYMMETRIC MATRIX OF M X M, WHERE M = MP + MQ)
  21. C                   CONTAINING CORRELATION COEFFICIENTS.  (STORAGE MODE
  22. C                   OF 1)
  23. C           ROOTS - OUTPUT VECTOR OF LENGTH MQ CONTAINING EIGENVALUES
  24. C                   COMPUTED IN THE NROOT SUBROUTINE.
  25. C           WLAM  - OUTPUT VECTOR OF LENGTH MQ CONTAINING LAMBDA.
  26. C           CANR  - OUTPUT VECTOR OF LENGTH MQ CONTAINING CANONICAL
  27. C                   CORRELATIONS.
  28. C           CHISQ - OUTPUT VECTOR OF LENGTH MQ CONTAINING THE
  29. C                   VALUES OF CHI-SQUARES.
  30. C           NDF   - OUTPUT VECTOR OF LENGTH MQ CONTAINING THE DEGREES
  31. C                   OF FREEDOM ASSOCIATED WITH CHI-SQUARES.
  32. C           COEFR - OUTPUT MATRIX (MQ X MQ) CONTAINING MQ SETS OF
  33. C                   RIGHT HAND COEFFICIENTS COLUMNWISE.
  34. C           COEFL - OUTPUT MATRIX (MP X MQ) CONTAINING MQ SETS OF
  35. C                   LEFT HAND COEFFICIENTS COLUMNWISE.
  36. C           R     - WORK MATRIX (M X M)
  37. C
  38. C        REMARKS
  39. C           THE NUMBER OF LEFT HAND VARIABLES (MP) SHOULD BE GREATER
  40. C           THAN OR EQUAL TO THE NUMBER OF RIGHT HAND VARIABLES (MQ).
  41. C           THE VALUES OF CANONICAL CORRELATION, LAMBDA, CHI-SQUARE,
  42. C           DEGREES OF FREEDOM, AND CANONICAL COEFFICIENTS ARE COMPUTED
  43. C           ONLY FOR THOSE EIGENVALUES IN ROOTS WHICH ARE GREATER THAN
  44. C           ZERO.
  45. C
  46. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  47. C           MINV
  48. C           NROOT  (WHICH, IN TURN, CALLS THE SUBROUTINE EIGEN.)
  49. C
  50. C        METHOD
  51. C           REFER TO W. W. COOLEY AND P. R. LOHNES, 'MULTIVARIATE PRO-
  52. C           CEDURES FOR THE BEHAVIORAL SCIENCES', JOHN WILEY AND SONS,
  53. C           1962, CHAPTER 3.
  54. C
  55. C     ..................................................................
  56. C
  57.       SUBROUTINE CANOR (N,MP,MQ,RR,ROOTS,WLAM,CANR,CHISQ,NDF,COEFR,
  58.      1                  COEFL,R)
  59.       DIMENSION RR(1),ROOTS(1),WLAM(1),CANR(1),CHISQ(1),NDF(1),COEFR(1),
  60.      1          COEFL(1),R(1)
  61. C
  62. C        ...............................................................
  63. C
  64. C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE
  65. C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION
  66. C        STATEMENT WHICH FOLLOWS.
  67. C
  68. C     DOUBLE PRECISION RR,ROOTS,WLAM,CANR,CHISQ,COEFR,COEFL,R,DET,SUM
  69. C
  70. C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS
  71. C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS
  72. C        ROUTINE.
  73. C
  74. C        THE DOUBLE PRECISION VERSION OF THIS SUBROUTINE MUST ALSO
  75. C        CONTAIN DOUBLE PRECISION FORTRAN FUNCTIONS.  SQRT IN STATEMENT
  76. C        165 MUST BE CHANGED TO DSQRT.  ALOG IN STATEMENT 175 MUST BE
  77. C        CHANGED TO DLOG.
  78. C
  79. C        ...............................................................
  80. C
  81. C     PARTITION INTERCORRELATIONS AMONG LEFT HAND VARIABLES, BETWEEN
  82. C     LEFT AND RIGHT HAND VARIABLES, AND AMONG RIGHT HAND VARIABLES.
  83. C
  84.       M=MP+MQ
  85.       N1=0
  86.       DO 105 I=1,M
  87.       DO 105 J=1,M
  88.       IF(I-J) 102, 103, 103
  89.   102 L=I+(J*J-J)/2
  90.       GO TO 104
  91.   103 L=J+(I*I-I)/2
  92.   104 N1=N1+1
  93.   105 R(N1)=RR(L)
  94.       L=MP
  95.       DO 108 J=2,MP
  96.       N1=M*(J-1)
  97.       DO 108 I=1,MP
  98.       L=L+1
  99.       N1=N1+1
  100.   108 R(L)=R(N1)
  101.       N2=MP+1
  102.       L=0
  103.       DO 110 J=N2,M
  104.       N1=M*(J-1)
  105.       DO 110 I=1,MP
  106.       L=L+1
  107.       N1=N1+1
  108.   110 COEFL(L)=R(N1)
  109.       L=0
  110.       DO 120 J=N2,M
  111.       N1=M*(J-1)+MP
  112.       DO 120 I=N2,M
  113.       L=L+1
  114.       N1=N1+1
  115.   120 COEFR(L)=R(N1)
  116. C
  117. C     SOLVE THE CANONICAL EQUATION
  118. C
  119.       L=MP*MP+1
  120.       K=L+MP
  121.       CALL MINV (R,MP,DET,R(L),R(K))
  122. C
  123. C        CALCULATE T = INVERSE OF R11 * R12
  124. C
  125.       DO 140 I=1,MP
  126.       N2=0
  127.       DO 130 J=1,MQ
  128.       N1=I-MP
  129.       ROOTS(J)=0.0
  130.       DO 130 K=1,MP
  131.       N1=N1+MP
  132.       N2=N2+1
  133.   130 ROOTS(J)=ROOTS(J)+R(N1)*COEFL(N2)
  134.       L=I-MP
  135.       DO 140 J=1,MQ
  136.       L=L+MP
  137.   140 R(L)=ROOTS(J)
  138. C
  139. C        CALCULATE A = R21 * T
  140. C
  141.       L=MP*MQ
  142.       N3=L+1
  143.       DO 160 J=1,MQ
  144.       N1=0
  145.       DO 160 I=1,MQ
  146.       N2=MP*(J-1)
  147.       SUM=0.0
  148.       DO 150 K=1,MP
  149.       N1=N1+1
  150.       N2=N2+1
  151.   150 SUM=SUM+COEFL(N1)*R(N2)
  152.       L=L+1
  153.   160 R(L)=SUM
  154. C
  155. C        CALCULATE EIGENVALUES WITH ASSOCIATED EIGENVECTORS OF THE
  156. C        INVERSE OF R22 * A
  157. C
  158.       L=L+1
  159.       CALL NROOT (MQ,R(N3),COEFR,ROOTS,R(L))
  160. C
  161. C     FOR EACH VALUE OF I = 1, 2, ..., MQ, CALCULATE THE FOLLOWING
  162. C     STATISTICS
  163. C
  164.       DO 210 I=1,MQ
  165. C
  166. C        TEST WHETHER EIGENVALUE IS GREATER THAN ZERO
  167. C
  168.       IF(ROOTS(I)) 220, 220, 165
  169. C
  170. C        CANONICAL CORRELATION
  171. C
  172.   165 CANR(I)= SQRT(ROOTS(I))
  173. C
  174. C        CHI-SQUARE
  175. C
  176.       WLAM(I)=1.0
  177.       DO 170 J=I,MQ
  178.   170 WLAM(I)=WLAM(I)*(1.0-ROOTS(J))
  179.       FN=N
  180.       FMP=MP
  181.       FMQ=MQ
  182.   175 CHISQ(I)=-(FN-0.5*(FMP+FMQ+1.0))*ALOG(WLAM(I))
  183. C
  184. C        DEGREES OF FREEDOM FOR CHI-SQUARE
  185. C
  186.       N1=I-1
  187.       NDF(I)=(MP-N1)*(MQ-N1)
  188. C
  189. C        I-TH SET OF RIGHT HAND COEFFICIENTS
  190. C
  191.       N1=MQ*(I-1)
  192.       N2=MQ*(I-1)+L-1
  193.       DO 180 J=1,MQ
  194.       N1=N1+1
  195.       N2=N2+1
  196.   180 COEFR(N1)=R(N2)
  197. C
  198. C        I-TH SET OF LEFT HAND COEFFICIENTS
  199. C
  200.       DO 200 J=1,MP
  201.       N1=J-MP
  202.       N2=MQ*(I-1)
  203.       K=MP*(I-1)+J
  204.       COEFL(K)=0.0
  205.       DO 190 JJ=1,MQ
  206.       N1=N1+MP
  207.       N2=N2+1
  208.   190 COEFL(K)=COEFL(K)+R(N1)*COEFR(N2)
  209.   200 COEFL(K)=COEFL(K)/CANR(I)
  210.   210 CONTINUE
  211.   220 RETURN
  212.       END
  213.